perm filename OCCULT[901,BGB] blob
sn#129629 filedate 1974-11-12 generic text, type T, neo UTF8
00100 TITLE PASS3
00200 EXTERNAL TRIBLKS,TRITAB,INPUT3,NUMTRI
00300 INTERNAL PASS3
00400 PASS3: 0
00500 SETZM NLEAST# ;COUNT OF TRIANGLES
00600 OPDEF OUTSTG [XWD 051140,0]
00700 ;ACCUMULATORS
00800 A←←XY1←←KA←←0
00900 B←←XY2←←AC0←←LA←←1
01000 C←←XY3←←AC1←←2
01100 AA←←I1←←Z12←←LO←←LB←←KB←←3
01200 BB←←I2←←Z3I←←HI←←4
01300 CC←←I3←←C12←←MID←←5
01400 X1←←AB1←←6
01500 X2←←AB2←←7
01600 X3←←AB3←←10
01700 Y1←←AB←←11
01800 Y2←←CC3←←12
01900 Y3←←13
02000 Z1←←Z←←14
02100 Z2←←TRI←←15
02200 Z3←←LC←←16
02300 ZT←←QB←←II←←KK←←KC←←17
02400 KPLANE←1
00100 LOOP: MOVE QB,NLEAST ;DONE YET
00200 CAML QB,NUMTRI
00300 JRST @PASS3
00400 ;BLIT TRIANGLE BLOCK INTO AC'S
00500 IMULI QB,5
00600 ADDI QB,INPUT3
00700 MOVSS QB
00800 BLT QB,4
00900 ;UNPACK TRIANGLE BLOCK
01000 FOR @$ I←1,3 {
01100 HLRE X$I,XY$I
01200 HRRE Y$I,XY$I ⎇
01300 HLRE Z1,Z12
01400 HRRE Z2,Z12
01500 HLRE Z3,Z3I
01600 HRRZ II,Z3I
01700 P3B:
01800 TRNE II,4 ↔ SKIPA I1,[1] ↔ SETZ I1,
01900 TRNE II,2 ↔ SKIPA I2,[1] ↔ SETZ I2,
02000 TRNE II,1 ↔ SKIPA I3,[1] ↔ SETZ I3,
02100 P3A:
02200 ;ORDER Z1 LEAST, Z3 MOST.
02300 DEFINE SWAP $ (N,M) {
02400 CAMG Z$N,Z$M
02500 JRST .+5
02600 EXCH X$N,X$M
02700 EXCH Y$N,Y$M
02800 EXCH Z$N,Z$M
02900 EXCH I$N,I$M ⎇
03000 SWAP 1,2
03100 SWAP 2,3
03200 SWAP 1,2
03300
03400 MOVE II,I1 ;RE-PACK I-BITS
03500 LSH II,1
03600 IOR II,I2
03700 LSH II,1
03800 IOR II,I3
03900
04000 EXCH II,[KPLANE]
00100 ;CALCULATE COEFFICIENTS OF THE PLANE OF THE TRIANGLE BY KRAMER'S RULE.
00200 DEFINE DET2B2 (A00,B11,B12,B21,B22) {
00300 MOVE B,B11
00400 MOVE C,B12
00500 IMUL B,B22
00600 IMUL C,B21
00700 SUB B,C
00800 IMUL B,A00 ⎇
00900
01000 DEFINE DETERM (A11,A12,A13,A21,A22,A23,A31,A32,A33) {
01100 DET2B2 A11,A22,A23,A32,A33
01200 MOVE A,B
01300 DET2B2 A12,A21,A23,A31,A33
01400 SUB A,B
01500 DET2B2 A13,A21,A22,A31,A32
01600 ADD A,B ⎇
01700
01800 DETERM KK,Y1,Z1,KK,Y2,Z2,KK,Y3,Z3
01900 MOVE AA,A
02000 DETERM X1,KK,Z1,X2,KK,Z2,X3,KK,Z3
02100 MOVE BB,A
02200 DETERM X1,Y1,KK,X2,Y2,KK,X3,Y3,KK
02300 MOVE CC,A
02400 DETERM X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
02500 MOVEM A,KSAVE#
02600 BRK:
03350 ;HALFWORD OVERFLOW.
03500 DEFINE HALFOV (W,WW){
03600 MOVM W,WW
03700 CAIGE W,400000
03800 JRST .+10
03900 MOVE W,KSAVE ;OVERFLOW
03910 ASH W,-1
03920 MOVEM W,KSAVE
03930 ASH AA,-1
03940 ASH BB,-1
03950 ASH CC,-1
04350 JRST .-11
04400 ⎇
04500 HALFOV A,AA
04600 HALFOV B,BB
04700 HALFOV C,CC
04800 P3C:
04900 ;PACK PLANE COEFFICIENTS
05000 HRL BB,AA
05100 HRLS CC
05200 EXCH KK,[KPLANE] ;COL-1
00100 ;CALCULATE LINE COEFFICIENTS
00200 DEFINE LINCOE (X1,X2,Y1,Y2,TA,TB,TC,X3,Y3) {
00300 MOVE TA,Y2
00400 MOVE TB,X1
00500 SUB TA,Y1 ;(Y2-Y1)=a
00600 SUB TB,X2 ;(X1-X2)=b
00700 HRL TC,TA
00800 HRR TC,TB
00900 IMUL TA,X1 ; A*x1
01000 IMUL TB,Y1 ; B*y1
01100 ADD TA,TB
01200 MOVNS TA
01300 MOVM TB,TA
01400 CAIGE TB,400000
01500 JRST .+6
01600 HLRE TA,TC ;HALFWORD OVERFLOW CURE
01700 HRRE TB,TC
01800 ASH TA,-1
01900 ASH TB,-1
02000 JRST .-15 ;JUMP TO THE "HRL" ABOVE.
02100 ;TA c
02200 ;TB free
02300 ;TC a,,b
02400 ;observe qqq sign convention - odd vertex positive.
02500 HLRE TB,TC
02600 IMUL TB,X3
02700 MOVEM TB,AC20
02800 HRRE TB,TC
02900 IMUL TB,Y3
03000 ADD TB,AC20
03100 ADD TB,TA
03200 JUMPGE TB,.+7
03300 MOVNS TA ;FLIP SIGN OF LINE COEFFICIENTS.
03400 HLRE TB,TC
03500 HRRE TC,TC
03600 MOVNS TB
03700 MOVNS TC
03800 HRL TC,TB
03900 ⎇
04000 HRL QB,Z3
04100 LINCOE X1,X2,Y1,Y2,A,B,C,X3,Y3
04200 LINCOE X1,X3,Y1,Y3,LA,LB,LC,X2,Y2 ;COL-2
04300 HRR CC,A ;PACK c3
04400 MOVEM KC,SAVKC#
04500 LINCOE X2,X3,Y2,Y3,KA,KB,KC,X1,Y1 ;COL-4
04600 HRL Y1,X1
04700 MOVE X1,KC
04800 MOVE KC,SAVKC
00100 P3D:
00200 ;PACK EVERYTHING INTO YOUR OLD KIT BAG AND SMILE SMILE SMILE
00300 ; WOULD YOU BELIEVE A LONG TRIANGLE BLOCK
00400 HRL Y2,X2
00500 HRL Y3,X3
00600 MOVE AB2,LC
00700 MOVE AB3,C
00800 MOVE 2,13
00900 HRL 1,0
01000 HRL 3,14
01100 HRR 3,15
01200 MOVE 0,11
01300 EXCH 1,12
01400 EXCH 5,12
01500 MOVE 11,4
01600 MOVE 4,17
01700 MOVE 13,KSAVE
01800
01900 ;BLIT BLOCK INTO LONG BLOCK TABLE.
02000 MOVE 17,NLEAST
02100 IMULI 17,14
02200 ADDI 17,TRIBLKS
02300 MOVE 16,17
02400 ADDI 16,13
02500 BLT 17,@16
00100 P3E:
00200 ;PUT TRIANGLE BLOCK POINTER INTO THE TRIANGLE TABLE
00300 ;IN ORDER ON MINIMUM DEPTH.
00400 HRL ZT,Z
00500 MOVE TRI,NUMTRI
00600 SKIPN LO,NLEAST
00700 JRST [AOS NLEAST ;FIRST TIME ONLY.
00800 MOVEM ZT,TRITAB-1(TRI)
00900 JRST LOOP]
01000 SETZ HI,
01100 PUT1: MOVE MID,LO ;MID:=(LO+HI+1)/2
01200 ADD MID,HI
01300 AOS MID
01400 ASH MID,-1
01500 MOVE LC,TRI ;FETCH Z(MID)
01600 SUB LC,MID
01700 HLRE A,TRITAB(LC)
01800 CAML Z,A
01900 JRST [CAMN LO,MID
02000 JRST PUT2
02100 CAMN HI,MID
02200 JRST PUT2
02300 MOVE LO,MID
02400 JRST PUT1]
02500 CAMN LO,MID
02600 JRST [AOS MID
02700 JRST PUT2]
02800 CAMN HI,LO
02900 JRST [AOS MID
03000 JRST PUT2]
03100 MOVE HI,MID
03200 JRST PUT1
03400 ;MOVE THE LOWER PART OF THE TRIANGLE TABLE,
03500 ;BETWEEN NLEAST AND MID,
03600 ;DOWN CORE BY ONE WORD.
03800 PUT2: CAMLE MID,NLEAST
03900 JRST PUT3
04000 MOVEI AC0,TRITAB
04100 ADD AC0,TRI
04200 MOVE AC1,AC0
04300 SUB AC0,NLEAST
04400 HRLS AC0
04500 SOS AC0
04600 SUB AC1,MID
04700 SOS AC1
04800 BLT AC0,@AC1
04900 PUT3: AOS NLEAST
05000 SUB TRI,MID
05100 MOVEM ZT,TRITAB(TRI)
05200 JRST LOOP
05300 AC20: 0
05400 END
00100 TITLE OCCULT
00200 EXTERNAL NUMTRI,OUTPDL,TRITAB,ENDPDL
00300 INTERNAL OCCULT
00400 OPDEF OUTSTR[XWD 5114,0]
00500 ;USE AND ABUSE OF ACCUMULATORS
00600 AC0←←0
00700 AC1←←1
00800 XM←←0
00900 YM←←1
01000
01100 XL←2 ;The window.
01200 XH←3
01300 YL←4
01400 YH←5
01500
01600 X1←AA←←6 ;The triangle.
01700 X2←BB←←7
01800 X3←CC←←10
01900
02000 Y1←MINZ←←11
02100 Y2←MAXZ←←12
02200 Y3←13
02300
02400 AB←←14 ;Plane coefficients.
02500 C←←15
02600
02700 T←16
02800 TT←17
02900 KPLANE←20000
03000
03100 XO←←14
03200 YO←←15
03300 PB←←17
03400
03500 ODD←←13
03600 NEW←←14
03700 OLD←←15
03800
03900 XY←←11
04000 X←←6
04100 Y←←7
04200 Z←←10
04300 EPTR←←14
04400 BPTR←←15
04500 CTB←←17
00100 ;O.O.R. - Occult Object Remover.
00200 OCCULT: 0
00300 hrl TT,numtri ;Triangle pointer.
00400 movns TT ;This op covertly Subtracts one from left half.
00500 hrri TT,tritab-1
00600 movem TT,triptr#
00700
00800 movni XL,1000 ;first window
00900 movei XH,1000
01000 movni YL,1000
01100 movei YH,1000
01200 FOR W IN (PENOLD,PENNEW,SUR,SUR3,APEN,ASUR,ASUR3){
01300 SETZM W}
01400 movei 377777
01500 movem ZH#
01600 movei sqrpdl+1
01700 movem sqrpdl
01800 movei outpdl+1
01900 movem outpdl
02000 jrst .V
02100 ;Occult Window Loop.
02200 OWLOOP: sos 1,sqrpdl
02300 caig 1,sqrpdl
02400 jrst @occult ;no more windows.
02500
02600 hlre XL,-5(1) ;new window
02700 hrre XH,-5(1)
02800 hlre YL,-4(1)
02900 hrre YH,-4(1)
03000
03100 hrre -3(1) ;back limit.
03200 movem ZH
03300
03400 move (1) ;triangle pointer
03500 movem triptr
03600
03700 move -2(1) ;ancesters
03800 movem apen#
03900 move -1(1)
04000 movem asur#
04100 hlrz -3(1)
04200 movem asur3#
04300
04400 setzm pennew# ;descendants
04500 setzm penold#
04600 setzm sur#
04700 setzm sur3#
04800
04900 subi 1,5
05000 movem 1,sqrpdl
05100 jrst .V
00100 ;Virgin - scan for first triangle.
00200 .V: jsr pns
00300 jrst [ movem minz,penzlo#
00400 movem maxz,penzhi#
00500 movem T,pennew
00600 jrst .P]
00700 jrst owloop
00800 movem minz,surzlo#
00900 movem maxz,surzhi#
01000 hrlzm T,sur
01100
01200 ;One surrounder.
01300 .S: jsr pns
01400 jrst [ caml minz,surzhi
01500 jrst .S ;B - penetrator is behind surrounder.
01600 movem T,pennew
01700 caml maxz,surzlo
01800 jrst %PS ;C - penetrator and surrounder conflict.
01900 movem minz,penzlo ;F - penetrator is in Front of surrounder
02000 movem maxz,penzhi
02100 jrst .SP]
02200 jrst alpha ;DISPLAY a surrounder.
02300 caml minz,surzhi
02400 jrst .S ;B - new surrounder is behind old surrounder.
02500 caml maxz,surzlo
02600 jrst [ movem minz,zlo# ;C - surrounders conflict.
02700 movem maxz,zhi#
02800 hrrm T,sur
02900 jrst .SS]
03000 movem minz,surzlo ;F - new surrounder is in front of old surrounder
03100 movem maxz,surzhi
03200 hrlm T,sur
03300 jrst .S
03400
03500 ;One Penetrator.
03600 .P: jsr pns
03700 jrst [movem T,penold
03800 camle minz,penzhi
03900 jrst %PP ;B
04000 caml maxz,penzlo
04100 jrst .PP ;C
04200 jrst %PP] ;F
04300
04400 jrst beta ;DISPLAY penetrator.
04500
04600 movem minz,surzlo
04700 movem maxz,surzhi
04800 hrlzm T,sur
04900 caml minz,penzhi
05000 jrst .PS ;B
05100 caml maxz,penzlo
05200 jrst %PS ;C
05300 setzm pennew ;F
05400 jrst .S
05500
05600 ;Two surrounders.
05700 .SS: jsr pns
05800 jrst [ caml minz,surzhi
05900 jrst .SS ;B
06000 caml minz,zhi ;F & C
06100 jrst .SS ;b
06200 movem T,pennew ;f & c
06300 jrst %PSS]
06400 jrst gamma ;DISPLAY two penetrators.
06500
06600 caml minz,surzhi
06700 jrst .SS ;B
06800 caml maxz,surzlo
06900 jrst [ caml minz,zhi ;C
07000 jrst .SS ;b
07100 caml maxz,zlo
07200 jrst [ hrrzm T,sur3 ;c
07300 jrst %SSS]
07400 hrrm T,sur
07500 movem minz,zlo
07600 movem maxz,zhi
07700 jrst .SS]
07800 caml minz,zhi
07900 jrst .SS
08000 caml maxz,zlo
08100 jrst [ hrlm T,sur ;c
08200 movem minz,surzlo
08300 movem maxz,surzhi
08400 jrst .SS]
08500 hrlzm T,sur ;f
08600 movem minz,surzlo
08700 movem maxz,surzhi
08800 jrst .S
08900
00100 ;A surrounder behind a penetrator.
00200 .PS:
00300 .SP: jsr pns
00400 jrst [ caml minz,surzhi
00500 jrst .PS ;B
00600 movem T,penold
00700 caml maxz,surzlo
00800 jrst %PPS ;C
00900 camle minz,penzhi ;F
01000 jrst %PP ;b
01100 caml minz,penzlo
01200 jrst .PP ;c
01300 jrst %PP] ;f
01400
01500 jrst beta ;DISPLAY.
01600
01700 caml minz,surzhi
01800 jrst .PS ;B
01900 caml maxz,surzlo
02000 jrst [ hrrm T,sur ;C
02100 jrst %PSS]
02200 hrlm T,sur ;F
02300 movem minz,surzlo
02400 movem maxz,surzhi
02500 caml minz,penzhi
02600 jrst .PS ;B
02700 caml maxz,penzlo
02800 jrst %PS ;C
02900 setzm pennew ;F
03000 jrst .S
03100
03200
03300 SQRPDL: .+1 ;WINDOW SQUARE IN CORE PUSHDOWN LIST
03400 0 ; XL XH
03500 0 ; YL YH
03600 0 ;sur3,,ZH
03700 0 ; PEN1,,PEN2
03800 0 ; SUR1,,SUR2
03900 0 ; TRIPTR
04000 BITS←←=10 ;NUMBER OF BITS OF DISPLAY RASTER.
04100 BLOCK (BITS*3+1)*6
04200 SQREND:
04300 FACES←←12 ;CORNER PENETRATION DATA AREA
04400 CORPDL: .+1
04500 BLOCK FACES
04600 PENPDL: .+1
04700 BLOCK FACES
04800 CTBPTR: .+1
04900 BLOCK FACES*13
00100 ;Display output one-surrounder.
00200 alpha: jrst owloop
00300 ;DISPLAY OUTPUT ONE-PENETRATOR.
00400 BETA: MOVE AC0,XH
00500 SUB AC0,XL
00600 HRLM AC0,@OUTPDL
00700 MOVE AC1,PENNEW
00800 HRRM AC1,@OUTPDL
00900 AOS OUTPDL
01000 HRLM XL,@OUTPDL
01100 HRRM YL,@OUTPDL
01200 AOS OUTPDL
01300 JRST OWLOOP
01400
01500 ;DISPLAY OUTPUT TWO-SURROUNDERS
01600 GAMMA: MOVE AC0,XH
01700 SUB AC0,XL
01800 TRO AC0,400000
01900 HRLM AC0,@OUTPDL
02000 HLRZ 1,SUR
02100 HRRM AC1,@OUTPDL
02200 AOS OUTPDL
02300 HRLM XL,@OUTPDL
02400 HRRM YL,@OUTPDL
02500 AOS OUTPDL
02600 HRRZ 1,SUR
02700 HRRZM AC1,@OUTPDL
02800 AOS OUTPDL
02900 JRST OWLOOP
03000 ;Display two penetrators.
03100 EPSILON:
03200 MOVE XH
03300 SUB XL
03400 HRLM @OUTPDL
03500 MOVE 1,PENOLD
03600 HRRM @OUTPDL
03700 AOS OUTPDL
03800 HRLM XL,@OUTPDL
03900 HRRM YL,@OUTPDL
04000 AOS OUTPDL
04100 JRST BETA
00100 ;OCCUPATION VOLUME
00200
00300 ; Compute the occupation volume of the Triangle pointed
00400 ;to by T for the window XL XH YL YH, find the minimum and maximum Z for all
00500 ;corners of the window without exceeding the triangle's total volume z1
00600 ;minimum to z3 maximum; if you are worth anything you have by now realized
00700 ;that this will yield too large a volume for numerous penetrator cases
00800 ;where the vertices aren't in the window and the corners aren't in the triangle
00900 ;but it doesn't matter and will all come out correctly further along.
01000
01100 OCCVOL: 0
01200 HLRE AA,11(T) ;PICKUP COEFFICIENTS OF TRIANGLE'S PLANE.
01300 HRRE BB,11(T)
01400 HLRE CC,12(T)
01500 SETCM T
01600 TLNE (5B2) ;IF EXTREME VERTICES ARE WITHIN...
01700 JRST .+4
01800 HLRE MINZ,3(T) ;THEN OCCUPATION VOLUME IS OBVIOUS.
01900 HLRE MAXZ,4(T)
02000 JRST @OCCVOL
02100 HRLZI MAXZ,400000 ;Z1
02200 SETCAM MAXZ,MINZ ;Z3
02300 ;calculte z-depth of window corners in the plane of the triangle.
02400 FOR I←0,3
02500 {
02600 MOVEI AC0,KPLANE
02700 MOVE AC1,XL+(I∧1)
02800 IMUL AC1,AA
02900 SUB AC0,AC1
03000 MOVE AC1,YL+((I∧2)⊗-1)
03100 IMUL AC1,BB
03200 SUB AC0,AC1
03300 IDIV AC0,CC
03400 CAMGE AC0,MINZ
03500 MOVE MINZ,AC0
03600 CAMLE AC0,MAXZ
03700 MOVE MAXZ,AC0
03800 ⎇
03900 ;Clip window's projected volume to the extreme volume of the triangle.
04000 HLRE AC0,3(T)
04100 HLRE AC1,4(T)
04200 CAMLE AC0,MINZ
04300 MOVE MINZ,AC0
04400 CAMGE AC1,MAXZ
04500 MOVE MAXZ,AC1
04600
04700
04800 JRST @OCCVOL
00100 ;P.O.S. - Penetrator, Outsider, Surrounder.
00200 pos:
00300 comment/ POS determines the relationship between a triangle and a window
00400 and skips respectively. For penetrators it always calculates
00500 vertex-within-bits, For Pen & Surs it always calculates volume.
00600 Accumulators IN: XL,XH,YL,YH, & T(right half).
00700 /
00800
00900 ;GET TRIANGLE'S COORDINATES INTO ACCUMULATORS.
01000 define gettac {
01100 hlre x1,0(T)
01200 hlre x2,1(T)
01300 hlre x3,2(T)
01400 hrre y1,0(T)
01500 hrre y2,1(T)
01600 hrre y3,2(T)
01700 }
01800 gettac
01900
02000 ;If all the corners of the triangle are to one side of the window,
02100 ; then the triangle is Outside.
02200
02300 define Outside $ (M,N,P,HL) {
02400 CAM$M P$HL,P$1 ↔ JRST .+5
02500 CAM$M P$HL,P$2 ↔ JRST .+3
02600 CAM$N P$HL,P$3 ↔ JRST pnsout
02700 }
02800 Outside L,GE,X,H
02900 Outside L,GE,Y,H
03000 Outside G,LE,X,L
03100 Outside G,LE,Y,L
03200
03300
03400 ;If any vertex of the Triangle is within the window,
03500 ; then it is a penetrator.
03600
03700 For @$ N←1,3 {
03800 camle X$N,XH ↔ jrst .+7
03900 camle XL,X$N ↔ jrst .+5
04000 camle Y$N,YH ↔ jrst .+3
04100 camg YL,Y$N ↔ ior T,[1⊗(=36-N)]
04200 }
04300
04400 tlnn T,(7b2)
04500 jrst .+3
04600 jsr occvol ;Found a Penetrator.
04700 jrst @pns
04800
04900
00100 ;SURROUNDS
00200
00300 comment/ For each edge of the triangle, if for every corner of
00400 the window QQQ is the same sign then that edge does not pass
00500 thru the window. The odd vertex is in the opposite half plane
00600 from the window if the QQQs are all negative - which is
00700 equivalent to saying that the triangle is outside of the window.
00800 /
00900 jsr calq
01000 jrst pnsout ;OUTSIDE.
01100 tlne T,77770
01200 jrst [jsr occvol ↔ jrst @pns] ;PENETRATOR.
01300 jsr occvol ↔ camge maxz,zh ↔ movem maxz,zh ;lower ZH - SURROUNDER.
01400 aos pns
01500 aos pns
01600 jrst @pns
01700
01800 ;P.N.S - Penetrator, Nil list, Surrounder.
01900 pns: 0
02000 ;Get pointer to next triangle, if list is empty or triangle is
02100 ;beyond the back limit then take the NIL exit.
02200 pnsout: skipe T,asur ;Check for ancestors.
02300 jrst [hlrzs T ;left SUR 1.
02400 jumpe T,[exch T,asur ;right SUR 2
02500 jrst pnssur]
02600 hrrzs asur
02700 jrst pnssur]
02800 skipe T,asur3
02900 jrst [setzm asur3
03000 jrst pnssur]
03100 skipe T,apen
03200 jrst [hlrzs T ;left PEN 1
03300 jumpe T,[exch T,apen ;right pen 2
03400 jrst pos]
03500 hrrzs apen
03600 jrst pos]
03700 move TT,Triptr
03800 beyond: aobjp TT,[aos pns
03900 jrst @pns]
04000 movem TT,Triptr
04100 hrrz T,(TT)
04200 hlre (TT)
04300 caml zh
04400 jrst @beyond ;beyond ZH.
04500 jrst pos
04600 pnssur: jsr occvol ↔ camge maxz,zh ↔ movem maxz,zh ;lower Zh.
04700 aos pns ;surrounds
04800 aos pns
04900 jrst @pns
00100 ;Calculate QQQ-bits, skip if not outside.
00200 calq: 0
00300 movsi PB,40000 ;Select QQQ bit.
00400 define qqq (corner) {
00500 hlre ac1,AB
00600 hrre ac0,AB
00700 imul ac1,XL+ (corner ∧ 1)
00800 imul ac0,YL+((corner ∧ 2)⊗-1)
00900 add ac1,ac0
01000 add ac1,C
01100 }
01200
01300 for edge ← 1,3 {
01400 move AB,5+edge(T) ;Get line Coefficients
01500 IFE (edge-1),<hlre C,5(T)>
01600 IFE (edge-2),<hrre C,5(T)>
01700 IFE (edge-3),<hrre C,12(T)>
01800 for corner ← 0,3 {
01900 qqq corner
02000 skipge ac1 ;Q sign convention - odd vertex positive.
02100 ior T,PB
02200 rot PB,-1
02300 }
02400
02500 setcm ac1,T
02600 tlnn ac1,(17⊗(=33-edge*4))
02700 jrst @calq ;Triangle outside of window.
02800 }
02900 aos calq
03000 jrst @calq
00100 ;Convert QQQ-bits into Pen-bits.
00200 CONQQQ: 0
00300 ;Accumulators IN: XL,XH,YL,YH (the window)
00400 ; X1,X2,X3,Y1,Y2,Y3 (the triangle)
00500 ; T (the triangle pointer)
00600 ;Accumulators clobbered 0,1,14,15.
00700 tlne T,(7B2) ;If a vertex is within, then we must calQ.
00800 jrst [gettac ;get triangle's coordinates.
00900 jsr calq
01000 jfcl
01100 jrst .+1]
01200 for @$ edge←1,3 {
01300 BP←←2+edge*4 ;Bit pointer for testing.
01400 V ←←((7-edge)*edge)/2 ;non-edge select bits.
01500 setcm T ;If both vertices within,
01600 tlne (V ⊗=33)
01700 jrst .+3
01800 tlz T,(17⊗(=35-BP)) ;Then zero NSEW byte.
01900 jrst conq$edge
02000
02100 ;Convert 4-bit byte by table lookup.
02200 ldb ac1,[point 4,T,BP]
02300 move [ 0 ↔ 12 ↔ 11 ↔ 3 ↔ 6 ↔ 14 ↔ 0 ↔ 5
02400 5 ↔ 0 ↔ 14 ↔ 6 ↔ 3 ↔ 11 ↔ 12 ↔ 0](ac1)
02500
02600 tlne T,(V ⊗ =33) ;If both vertices without
02700 jrst .+3
02800 dpb [point 4,T,BP]
02900 jrst conq$edge ;Then we are done, Else:
03000
03100 ;Find vertex that is outside the window.
03200 selec1←←(IFE(1-edge),<1+>0) ;1,0,0 - first select.
03300 selec2←←(IFE(3-edge),<1+>1) ;2,2,1 - second select.
03400 tlne T,(1⊗(=35-selec1))
03500 ;First selected bit is inside, hence second is outside.
03600 jrst [
03700 move XO,X1+selec2
03800 move YO,Y1+selec2
03900 jrst .+3]
04000
04100 ;First selected bit is outside.
04200 move XO,X1+selec1
04300 move YO,y1+selec1
04400
04500 ;Call one-crossing routine & you are done.
04600 jsr cross
04700 dpb [point 4,T,BP]
04800 conq$edge:
04900 }
05000 jrst @conqqq
00100 CROSS: 0
00200
00300 comment / The following tortured logic converts qqq-bits (which
00400 tell which half plane the window corners are in with respect
00500 to the lines determined by the triangle) into pen-bits (which
00600 tell which sides of the window: North, South, East or West, each
00700 triangle edge segment crosses).
00800
00900 Accumulators: XO,YO & AC1.
01000 /
01100
01200 ;If the 2-bit is on
01300 trne 2 ↔ jrst [
01400 ;then
01500
01600 ;If XO ≥ XH
01700 caml XO,XH ↔ jrst [
01800 ;Then 2-mask
01900 andi 2
02000 jrst @cross ]
02100 ;Else 15-mask
02200 andi 15
02300 jrst @cross ]
02400
02500 ;Else
02600 ;If 10-bit is on
02700 trne 10 ↔ jrst [
02800 ;Then If YO ≥ YH
02900 caml YO,YH ↔ jrst [
03000 ;Then 10-mask
03100 andi 10
03200 jrst @cross]
03300 ;Else 5-mask
03400 andi 5
03500 jrst @cross]
03600 ;Else If XL > XO
03700 camle XL,XO ↔ jrst [
03800 ;Then 1-mask
03900 andi 1
04000 jrst @cross]
04100 ;Else 4-mask
04200 andi 4
04300 jrst @cross
00100 ;Two Penetrators.
00200 ;Is an edge possible
00300 ;Do both pen have no vertices within
00400 .pp: move T,pennew
00500 tlne T,(7B2)
00600 jrst corn0
00700 move TT,penold
00800 tlne TT,(7B2)
00900 jrst corn0
01000
01100 ;Does ONLY ONE and the same edge intersect the window for each pen
01200 .PP1:
01300 define edgep $ (NNN) {
01400 jsr conqqq ;convert q-bits into pen-bits.
01500 movei 1
01600 movem en$nnn
01700 ldb [point 4,T,6]
01800 jumpn [ ldb 1,[point 8,T,14]
01900 jumpn 1,%PP
02000 jrst .+6]
02100 aos en$nnn
02200 ldb [point 4,T,10]
02300 jumpn [ldb 1,[point 4,t,14]
02400 jumpn 1,%PP
02500 jrst .+3]
02600 aos en$nnn
02700 ldb [point 4,T,14]
02800 movem ep$nnn
02900 movem T,IFE(nnn-1),<pennew> IFE(nnn-2),<penold>
03000 }
03100 edgep 1
03200 move T,penold
03300 edgep 2
03400 move TT,T
03500 move T,pennew
03600 came ep1
03700 jrst %PP ;Penetration bits do not match.
00100 ;Are the edges' endpoints identical
00200 .PP2: move 1,en1 ;edge new's number.
00300 hrrz new,T ;pennew pointers
00400 hrl new,T
00500 hrrz old,TT ;penold pointers
00600 hrl old,TT
00700 add new,[0 ↔ xwd 1,2 ↔ xwd 0,2 ↔ xwd 0,1](1)
00800 move 1,en2
00900 add old,[0 ↔ xwd 1,2 ↔ xwd 0,2 ↔ xwd 0,1](1)
01000 move (new)
01100 came (old)
01200 jrst [movss old
01300 came (old)
01400 jrst %PP ;match failure
01500 jrst .+1]
01600 movss new
01700 movss old
01800 move (new)
01900 came (old)
02000 jrst %PP ;match failure.
02100
02200 ;Are odd vertices in opposite half planes
02300 .PP3:
02400 comment / Let's do this one by picking up pennew's
02500 line-coefficients and penold's odd-vertex and multiplying
02600 them together in order to look at Q's sign./
02700
02800 ;Get line coefficients for edge-pennew 1.
02900 move 1,en1
03000 xct [0
03100 hlre C,5(T)
03200 hrre C,5(T)
03300 hrre C,12(T)](1)
03400 add 1,T
03500 move AB,5(T)
03600
03700 ;Get odd-vertex for edge-penold 2; x y z.
03800 .PP4: move odd,en2
03900 xct [0
04000 hlre 3(TT)
04100 hrre 3(TT)
04200 hlre 4(TT)](odd)
04300 movem zodd# ;save odd z-depth value.
04400 add odd,TT
04500 move odd,-1(odd) ;odd's x,,y.
04600
00100 ;Calculate QQQ.
00200 .PP5: hlre ac1,AB
00300 hlre ac0,odd
00400 imul ac1,ac0 ; a*X + ...
00500 hrre ac0,AB
00600 hrre AB,odd
00700 imul ac0,AB ; b*Y + ...
00800 add ac1,ac0
00900 add ac1,C ; c = qqq
01000 jumpge ac1,EdOver ;Edge's penetrators overlap.
01100 ;Coplanar & No intensity turned on edge
01200 move 1,en1
01300 ldb ibpt(1)
01400 jumpn .PP7
01500 move 1,en2
01600 ldb ibptt(1)
01700 jumpn .PP7
01800 move 11(T) ;coplanar test.
01900 hllz 1,12(T)
02000 came 11(TT)
02100 jrst .PP7 ;not coplanar.
02200 hllz 12(T)
02300 came 1,0
02400 jrst .PP7 ;not coplanar.
02500 ;Full Fledged Surrounder.
02600 move pennew
02700 hrlzm sur
02800 setzm pennew
02900 setzm penold
03000 move penzlo ↔ movem surzlo
03100 move penzhi ↔ movem surzhi
03200 camge ZH ↔ movem ZH
03300 jrst .S
00100 ;Final Edge Logic.
00200 .PP7: camge minz,penzlo ↔ movem minz,penzlo
00300 camle maxz,penzhi ↔ movem maxz,penzhi
00400 move penzhi ↔ camge zh ↔ movem zh
00500 ;pseudo-surrounder.
00600 move Triptr ;save pointer.
00700 movem Tpsav#
00800 .PP7a: jsr pns
00900 jrst .PP8
01000 jrst epsilon
01100 skipe sur ↔ jrst [hrrm T,sur ↔ jrst .PP8]
01200 hrlzm T,sur
01300 caml minz,penzhi
01400 jrst .PP7a ;B
01500 caml maxz,penzlo
01600 jrst .PP8 ;C
01700 setzm pennew ;F
01800 setzm penold
01900 movem minz,surzlo
02000 movem maxz,surzhi
02100 jrst .S
02200 ;Final Edge Failure.
02300 .PP8: move Tpsav
02400 movem Triptr
02500 jrst %PP
02600 ;Edge Parametes
02700 en1: 0 ;pennew's edge's number.
02800 en2: 0 ;penold's edge's number.
02900 ep1: 0 ;pennew's edge's pen-bits byte.
03000 ep2: 0 ;penold's edge's pen-bits byte.
03100 ;define intensity bit byte pointers.
03200 ibptt: 0
03300 point 1,4(TT),33
03400 point 1,4(TT),34
03500 point 1,4(TT),35
03600 ibpt: 0
03700 point 1,4(T),33
03800 point 1,4(T),34
03900 point 1,4(T),35
00100 ;The two edge penetrators overlap,
00200 ; that is the odd vertices are not in opposite halfplanes.
00300 EdOver:
00400 comment/ We shall determine which penetrator is hidden by finding
00500 out which is deeper from the window.
00600
00700 Accumulators IN: AA,BB,CC which contain the plane coefficients
00800 of pennew leftover from occvol.
00900 & ODD odd vertex of penold.
01000
01100 Also remember that AA*x + BB*y + CC*z = kplane.
01200 /
01300 movei ac0,kplane
01400 hlre ac1,odd
01500 imul ac1,AA
01600 sub ac0,ac1
01700 hrre ac1,odd
01800 imul ac1,BB
01900 sub ac0,ac1
02000 idiv ac0,CC
02100 camge ac0,zodd
02200
02300
02400 jrst [
02500 ;Penold is hidden, Pennew is a single penetrator.
02600 setzm penold ↔ movem minz,penzlo ↔ movem maxz,penzhi
02700 move 1,en2
02800 ldb ibptt(1)
02900 jumpe .P
03000 move 1,en1
03100 dpb ibpt(1)
03200 ]
03300
03400 ;Pennew is hidden, Penold is a single penetrator.
03500 move 1,en1
03600 ldb ibpt(1)
03700 jumpe .+3
03800 move 1,en2
03900 dpb ibptt(1)
04000 movem TT,pennew
04100 setzm penold
04200 jrst .P
00100 ;CORNER RECOGNITON.
00200 ;Do both pen have one and only and the same vertex within
00300 corn0: ldb 1,[point 3,T,2]
00400 caile 1,4
00500 jrst %PP
00600 cain 1,3
00700 jrst %PP
00800 jumpe 1,%PP
00900 move 1,[0 ↔ 3 ↔ 2 ↔ 0 ↔ 1](1)
01000 xct [0 ↔ hlre 3(T) ↔ hrre 3(T) ↔ hlre 4(T)](1)
01100 movem cornz#
01200 add 1,T
01300 move -1(1)
01400 movem cornxy#
01500 move TT,penold
01600 ldb 1,[point 3,TT,2]
01700 caile 1,4
01800 jrst %PP
01900 cain 1,3
02000 jrst %PP
02100 jumpe 1,%PP
02200 move 1,[0 ↔ 3 ↔ 2 ↔ 0 ↔ 1](1)
02300 add 1,TT
02400 move -1(1)
02500 came cornxy
02600 jrst %PP
02700 comment/ The above logic was in the hopes of a quick failure
02800 We are now confidant that a corner is extremely likely and
02900 we are now willing to compute alittle harder in order to
03000 recognize it. /
03100 ;Initialize Corner Recognition Tables and Save Pointers.
03200 CORN00: move Triptr
03300 movem TPsav
03400 camge minz,penzlo ↔ movem minz,penzlo ;common volume
03500 camge maxz,penzhi ↔ movem maxz,penzhi
03600 movei ctbptr+1
03700 movem ctbptr
03800 movei faces
03900 movnm face#
04000 setzm loose#
04100 setzm OLAP#
04200 movei penpdl+1
04300 movem penpdl
04400 movei corpdl+1
04500 movem corpdl
04600 jsr corner ;pennew
04700 move T,penold
04800 hlre AA,11(T) ;ad hoc pickup penold's plane coef.
04900 hrre BB,11(T)
05000 hlre CC,12(T)
05100 jsr corner ;penold
00100 ;Main Loop of Corner Recognition.
00200 corn1: jsr pns ;scan for next triangle
00300 jrst [ camge minz,penzlo ↔ movem minz,penzlo
00500 camle maxz,penzhi ↔ movem maxz,penzhi
00550 JSR CORNER
00600 jrst .-1]
00700 jrst theta ;sheet metal corner.
00800 skipe sur
00900 jrst [hrrm T,sur ↔ jrst .PP8]
01000 hrlzm T,sur
01100 caml minz,penzhi
01200 jrst corn1 ;B
01300 caml maxz,penzlo
01400 jrst .PP8 ;C
01500 setzm pennew ;F
01600 setzm penold
01700 movem minz,surzlo
01800 movem maxz,surzhi
01900 jrst .S
02000 ;CORNER COMPLETION.
02100 corn2: skipn OLAP
02200 jrst [move penzhi ;no overlap.
02300 camge ZH
02400 movem zH
02500 jrst .+1]
02600 jsr pns ;overlap occurred.
02700 jrst .PP8
02800 jrst corn3
02900 jrst .PP8
03000 corn3: sos 1,penpdl ;pop penetrators.
03100 caig 1,penpdl
03200 jrst owloop
03300 sos corpdl ;pop corner
03400 skipge @corpdl
03500 jrst corn3 ;overlapped are hidden.
03600 move XH ↔ sub XL ↔ hrlm @outpdl
03700 move 1,@penpdl ↔ hrrm 1,@outpdl ↔ aos outpdl
03800 hrlm XL,@outpdl
03900 hrrm YL,@outpdl
04000 aos outpdl
04100 move CTB,@corpdl
04200 ldb @5(CTB)
04300 jumpn .+3
04400 ldb @6(CTB)
04500 dpb @5(CTB)
04600 ldb @7(CTB)
04700 jumpn corn3
04800 ldb @10(CTB)
04900 dpb @7(CTB)
05000 jrst corn3
05100 ;sheet metal corners.
05200 Theta: skipe OLAP ↔ halt ↔ jrst epsilon ;cheat.
00100 CORNER: 0
00200 aosle face
00300 jrst [outstr[asciz/More than 10 faces meeting at a corner - Warning.
00400 /] ↔ jrst .PP8]
00500 jsr TEST
00600 jsr FETCH
00700
00800
00900
01000 define callap $ (A,C){ ;Call overLAP.
01100 move XY,Ov$A$xy ;pickup out vertex's coordinates.
01200 move X,Ov$A$x
01300 move Y,Ov$A$y
01400 move Z,Ov$A$z
01500 move Bptr,ed$A$BP
01600 movei Eptr,C
01700 add Eptr,ctbptr
01800 jsr ovrlap
01900 }
02000
02100
02200
02300 callap 1,3
02400 callap 2,7
02500 move ctbptr
02600 hrrm @corpdl ;put CTB pointer on corner pdl.
02700 aos corpdl
02800 addi 13
02900 movem ctbptr ;advance CTB pointer.
03000 jrst @corner
00100 TEST: 0
00200 move CTB,ctbptr
00300 ;Corner test for eligibilty of penetrator.
00400 ldb 1,[point 3,T,2]
00500 caile 1,4
00600 jrst .PP8 ;more than one vertex within window,
00700 cain 1,3
00800 jrst .PP8 ;likewise.
00900 JUMPE 1,.PP8
01000 move 1,[0 ↔ 3 ↔ 2 ↔ 0 ↔ 1](1)
01100 movem 1,vertex# ;vertex is within window.
01200 ;Does the vertex match the corner
01300 add 1,T
01400 move -1(1)
01500 came cornxy
01600 jrst .PP8 ;corner match failure,
01700 MOVE 1,VERTEX
01800 xct [0 ↔ hlre 3(T)
01900 hrre 3(T)
02000 hlre 4(T)](1)
02100 came cornz
02200 jrst .PP8 ;likewise
02300
02400 ;Put plane coef. into Corner table Block.
02500 movem AA,0(CTB)
02600 movem BB,1(CTB)
02700 movem CC,2(CTB)
02800 ;Calculate window intersection bits.
02900 jsr conqqq
03000 move 1,vertex
03100 ldb [0↔POINT 4,T,6↔POINT 4,T,10↔POINT 4,T,14](1)
03200 jumpn .PP8 ;Third edge of penetrator crosses window.
03300 ;increment loose edge counter.
03400 aos loose
03500 aos loose
03600 jrst @TEST
03700
00100 FETCH: 0
00200 MOVE CTB,CTBPTR
00300 movem t,@penpdl ↔ aos penpdl
00400 move 1,vertex
00500 ;store the FIRST out-vertex's x,y,z.
00600 caie 1,1
00700 jrst [ movem X1,ov1x# ;for in vertex 2 or 3
00800 movem Y1,ov1y# ; use triangle vertex 1.
00900 hlre 3(T)
01000 movem ov1z#
01100 jrst .+5]
01200 movem X2,ov1x ;for in vertex 1
01300 movem Y2,ov1y ; use triangle vertex 2
01400 hlre 3(T)
01500 movem ov1z
01600 ;store the SECOND our-vertex's x,y,z.
01700 caie 1,3
01800 jrst [ movem X3,ov2x# ;for in vertex 1 or 2
01900 movem Y3,ov2y# ; use triangle vertex 3.
02000 hlre 4(T)
02100 movem ov2z#
02200 jrst .+5]
02300 movem X2,ov2x ;for in vertex 3
02400 movem Y2,ov2y ; use triangle vertex 2
02500 hrre 3(T)
02600 movem ov2z
02700 ;store FIRST out-vertex's edge'S (which is the second-edge's)
02800 ; line-coefficients a,b,c and intensity bit pointer
02900 ; into the second-edge of the CTB block.
03000 caie 1,1
03100 jrst [ move 6(T) ;for in vertex 2 or 3.
03200 movem 7(CTB) ; use triangle edge 1.
03300 hlrz 5(T)
03400 movem 10(CTB)
03500 hrrz T
03600 add [point 1,4,33]
03700 movem 11(CTB)
03800 movem ed2bp#
03900 jrst .+11]
04000 move 7(T) ;for in vertex 1
04100 movem 7(CTB) ; use triangle edge 2.
04200 hrrz 5(T)
04300 movem 10(CTB)
04400 hrrz T
04500 add [point 1,4,34]
04600 movem 11(CTB)
04700 movem ed2bp
00100 ;store SECOND out-vertex's edge's (which is the first-edge's)
00200 ; line-coefficients a,b,c and intensity bit pointer
00300 ; into the first-edge of the CTB block.
00400 caie 1,3
00500 jrst [ move 10(T) ;for in vertex 1 or 2.
00600 movem 3(CTB) ; use triangle edge 3.
00700 hrrz 12(T)
00800 movem 4(CTB)
00900 hrrz T
01000 add [point 1,4,35]
01100 movem 5(CTB)
01200 movem ed1bp#
01300 jrst .+11]
01400 move 7(T) ;for in vertex 3
01500 movem 3(CTB) ; use triangle edge 2.
01600 hrrz 5(T)
01700 movem 4(CTB)
01800 hrrz T
01900 add [point 1,4,34]
02000 movem 5(CTB)
02100 movem ed1bp
02200 move ov1x
02300 hrl ov1y
02400 movsm ov1xy#
02500 movsm 6(CTB)
02600 move ov2x
02700 hrl ov2y
02800 movsm ov2xy#
02900 movsm 12(CTB)
03000 move ov1z
03100 hrlm 4(CTB)
03200 move ov2z
03300 hrlm 10(CTB)
03400 jrst @FETCH
00100 ;Record overlaps and link loose edges.
00200 OVRLAP: 0
00300
00400
00500
00600
00700 define LINK $ (M) {
00800 ;do x,,y & z match
00900 hlre M+1(CTB)
01000 came Z
01100 jrst link$M
01200 came XY,M+3(CTB)
01300 jrst link$M
01400 ;found a link.
01500 movem Bptr,M+3(CTB) ;put my IBP in his block.
01600 move M+2(CTB) ;put his IBP in my block.
01700 movem 3(Eptr)
01800 move ctbptr ;put my CTB in his link.
01900 hrlm M+1(CTB)
02000 hrlm CTB,1(Eptr) ;Put his CTB in my link.
02100 sosn loose ;decrement loose edge's counter.
02200 jrst CORN2 ;corner completion.
02300 jrst @OVRLAP ;overlap/link scan completed.
02400 link$M: }
02500
02600
02700
02800
02900 define ovqqq (nm) { ;compute QQQ
03000 hlre nm(CTB)
03100 imul X
03200 hrre 1,nm(CTB)
03300 imul 1,Y
03400 add 1
03500 hrre 1,nm+1(CTB)
03600 add 1
03700 jumpe [link nm↔ jrst .+2]
03800 jumpl ovrloop }
00100 movei corpdl+1
00200 movem pdlptr#
00300 movei CTB,ctbptr+1
00400 LAPLOOP: caml CTB,ctbptr
00500 jrst @ovrlap
00600 ovqqq 3
00700 ovqqq 7
00800 ;some one is overlapped.
00900 setom OLAP ;overlapped switch
01000 movei kplane
01100 move 1,(CTB)
01200 imul 1,X
01300 sub 1
01400 move 1,1(CTB)
01500 imul 1,Y
01600 sub 1
01700 idiv 2(CTB)
01800 camg Z,
01900 jrst [hrros @pdlptr ;he has been overlapped.
02000 jrst .+2 ]
02100 hrros @corpdl
02200 ovrloop: addi CTB,13 ↔ aos pdlptr ↔ jrst LAPLOOP
00100 ;Save Father's surrounders & penetrators and EXIT.
00200 %SSS: ↔ %PSS: ↔ %PPS: ↔ %PP: ↔ %PS:
00300 move 11,ZH
00400 hrl 11,sur3
00500 move 12,penold
00600 hrl 12,pennew
00700 move 13,sur
00800 move 14,triptr
00900 ;Split up the window, Recursion Exit.
01000 rexit: move XM,XL
01100 move YM,YL
01200 add XM,XH
01300 add YM,YH
01400 ash XM,-1
01500 ash YM,-1
01600 camn XL,XM ;resolution
01700 jrst owloop
01800 camn XH,XM
01900 jrst owloop
02000 move 6,sqrpdl ;setup blit pointer
02100 hrli 6,7
02200 move 15,6
02300 move 16,6
02400 move 17,6
02500 addi 16,6
02600 addi 17,14
02700 move 7,XH ;lower-right-window
02800 move 10,YM
02900 hrl 7,XM
03000 hrl 10,YL
03100 blt 15,5(6)
03200 movss 7 ;lower-left-window
03300 hrl 7,XL
03400 blt 16,13(6)
03500 movss 10 ;upper-left-window
03600 hrr 10,YH
03700 blt 17,21(6)
03800 addi 6,22
03900 movem 6,sqrpdl ;update pdl pointer.
04000 ;initialize OWL loop for upper-right window.
04100 move XL,XM
04200 move YL,YM
04300 movem 12,apen ;anscestors.
04400 movem 13,asur
04500 hlrzm 11,asur3
04600 setzm penold ;descendants.
04700 setzm pennew
04800 setzm sur
04900 setzm sur3
05000 jrst .V
05100 END
00100 TITLE DATA
00200 INTERNAL NUMTRI,TRIBLKS,TRITAB,INPUT3,INPUT6,FFLAG,INPUT5,OUTPDL
00300 INTERNAL ENDPDL,END6
00400 NUMTRI: 20
00500 TRIBLKS: 0
00600 BLOCK 400
00700 TRITAB: 0
00800 BLOCK 40
00900 INPUT3:
01000 DEFINE TRIANG (X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,N)
01100 {
01200 XWD X1,Y1
01300 XWD X2,Y2
01400 XWD X3,Y3
01500 XWD Z1,Z2
01600 XWD Z3,N
01700 ⎇
01800
01900 DEFINE QUAD (X1,Y1,X2,Y2,Z12,X3,Y3,X4,Y4,Z34)
02000 {
02100 TRIANG X1,Y1,Z12,X2,Y2,Z12,X3,Y3,Z34,5
02200 TRIANG X1,Y1,Z12,X3,Y3,Z34,X4,Y4,Z34,6
02300 ⎇
02400
02500 QUAD -500,-700,-500,-200, 200, 440,-200, 440,-700,200
02600 QUAD -440,-100,-440, 200, 600, 300, -40,300,-600, 100
02700 QUAD 0,100,0,500,100,440,500,440,100,100
02800 QUAD -440,400,-440,700,600,-240,700,-240,400,600
02900 QUAD 0,500,440,500,100,-240,700,-440,700,600
03000 QUAD 0,100,440,100,100,-240,400,-440,400,600
03100 QUAD 440,100,440,500,100,-240,700,-240,400,600
03200 QUAD 0,100,0,500,100,-440,700,-440,400,600
03205
03210 FFLAG: -1 ;FRAME FLAG
03215 OUTPDL: .+3
03220
03225 INPUT5: XWD 1200,INPUT3
03230 XWD -500,-500
03235 BLOCK 14000
03236 ENDPDL: 0 ↔ 0 ↔ 0 ↔ 0
03240 INPUT6: 0
03260 BLOCK 40000
03261 END6: 0 ↔ 0 ↔ 0 ↔ 0
03300 END